home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE14 / IDAPI / TJTABLE.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1996-09-05  |  11.7 KB  |  442 lines
  1. unit TJTable; {updated on 28/7/96}
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, DB, DBTables, DbiProcs, DbiTypes;
  8.  
  9. type
  10.   TPassWdPriv  = (prNone,prReadOnly,prModify,prInsert,prInsDel,prFull,prUnknown);
  11.   TPasswdPrivs = set of TPassWdPriv;
  12.   TDbiNameStr  = string[DBIMAXNAMELEN];
  13.   TRecNoCap    = (rnRecordNum, rnSequenceNum, rnUnsupported);
  14.  
  15.   TjocTable = class(TTable)
  16.   private
  17.     { Private declarations }
  18.     FTblType: array[0..DBIMAXNAMELEN] of char;
  19.     FDeleted: Boolean;     {is the record "soft" deleted}
  20.     FRecNoCap: TRecNoCap;  {sequence or record numbering supported}
  21.     FBMStable: Boolean;    {stable bookmarks?}
  22.     FSoftDelCap: Boolean;  {supports "soft" record deletion}
  23.     FRecordNumber: LongInt;
  24.     FShowDeleted: Boolean;
  25.     FBlockSize: Word;      {table block size}
  26.     FTableLevel: Word;     {table structure version}
  27.     FProtected: Boolean;   {is the table password protected?}
  28.     FPasswords: Word;      {number of auxiliary passwords}
  29.     FTableRights: TPasswdPrivs;
  30.     FRestructVer: Word;    {number of times restructured}
  31.     function GetDeleted: Boolean;
  32. {$IFNDEF Win32}
  33.     function GetRecordNumber: LongInt;
  34. {$ENDIF}
  35.     procedure InitTableProperties(const Cursor: HDBICur);
  36.     procedure SetShowDeleted(const Value: Boolean);
  37.     procedure BoolProp(const Value: Boolean);
  38.     procedure WordProp(const Value: Word);
  39.     procedure PasswdProp(const Value: TPasswdPrivs);
  40.     procedure PackPdoxTable;
  41.     function ChkShared: Boolean;
  42.     function GetOpenCursors: Word;
  43.   protected
  44.     { Protected declarations }
  45.     function CreateHandle: HDBICur; override;
  46.     procedure CheckActiveExclusive;
  47.     procedure CheckRemote;
  48.   public
  49.     { Public declarations }
  50.     property Deleted: Boolean read GetDeleted;
  51. {$IFNDEF Win32}
  52.     property RecNo: LongInt read GetRecordNumber;
  53. {$ENDIF}
  54.     property StableBookMarks: Boolean read FBMStable;
  55.     property ShowDeleted: Boolean read FShowDeleted write SetShowDeleted default False;
  56.     property IsShared: Boolean read ChkShared;
  57.     property OpenCount: Word read GetOpenCursors;
  58.     constructor Create(AOwner: TComponent); override;
  59.     destructor Destroy; override;
  60.     procedure UndeleteRecord;
  61.     procedure GotoRecord(const RecNo: LongInt);
  62.     procedure MoveRelative(const Delta: LongInt);
  63.     procedure Flush;
  64.     procedure Pack;
  65. {$IFNDEF Win32}
  66.     procedure RenameTable(const RenameTo: string);
  67. {$ENDIF}
  68.     procedure CopyTable(const Destination: string);
  69.     procedure RebuildIndexes;
  70.     procedure RebuildIndex(const Idx: Integer);
  71.     procedure RebuildNamedIndex(const IdxName: TDbiNameStr);
  72.   published
  73.     { Published declarations }
  74.     property BlockSize: Word read FBlockSize write WordProp;
  75.     property TableLevel: Word read FTableLevel write WordProp;
  76.     property IsProtected: Boolean read FProtected write BoolProp;
  77.     property PasswordCount: Word read FPasswords write WordProp;
  78.     property RestructVersion: Word read FRestructVer write WordProp;
  79.     property TableRights: TPasswdPrivs read FTableRights write PasswdProp;
  80.   end;
  81.  
  82.  
  83. function TransActive(ADatabase: TDatabase): Boolean;
  84. procedure Register;
  85.  
  86. implementation
  87.  
  88. uses DBConsts;
  89.  
  90. function TransActive(ADatabase: TDatabase): Boolean;
  91. var XAct: XInfo;
  92. begin
  93.   Result := False;
  94.   Check(DbiGetTranInfo(ADatabase.Handle, nil, @XAct));
  95.   Result := (XAct.exState = xsActive);
  96. end;
  97.  
  98. constructor TjocTable.Create(AOwner: TComponent);
  99. begin
  100.   inherited Create(AOwner);
  101.   FShowDeleted := False;
  102. end;
  103.  
  104. destructor TjocTable.Destroy;
  105. begin
  106.   inherited Destroy;
  107. end;
  108.  
  109. procedure TjocTable.BoolProp(const Value: Boolean);
  110. begin
  111. end;
  112.  
  113. procedure TjocTable.WordProp(const Value: Word);
  114. begin
  115. end;
  116.  
  117. procedure TjocTable.PasswdProp(const Value: TPasswdPrivs);
  118. begin
  119. end;
  120.  
  121. function TjocTable.ChkShared: Boolean;
  122. var WBool: Bool;
  123. begin
  124.   Result := False;
  125.   if State = dsInactive then DBError(SDataSetClosed);
  126.   Check(DbiIsTableShared(Handle, WBool));
  127.   Result := Boolean(WBool);
  128. end;
  129.  
  130. function TjocTable.GetOpenCursors: Word;
  131. var szTabName, szDBName: array[0..DBIMAXTBLNAMELEN] of char;
  132.     TempDb:              HDbiDb;
  133.     RetCode:             DBIResult;
  134.     DBDescr:             DBDesc;
  135. begin
  136.   Result := 0;
  137.   StrPCopy(szDBName, Databasename);
  138.   Check(DbiGetDatabaseDesc(szDBName, @DBDescr));
  139.   Check(DbiOpenDatabase(szDBName, DBDescr.szDBType, dbiREADONLY, dbiOPENSHARED,
  140.                                 nil, 0, nil, nil, TempDB));
  141.   StrPCopy(szTabName, TableName);
  142.   RetCode := DbiGetTableOpenCount(TempDB, szTabName, FTblType, Result);
  143.   DbiCloseDatabase(TempDB);
  144.   Check(RetCode);
  145. end;
  146.  
  147. procedure TjocTable.InitTableProperties(const Cursor: HDBICur);
  148. const PrivRights : array[TPasswdPriv] of Word =
  149.                     (prvNONE, prvREADONLY, prvMODIFY, prvINSERT,
  150.                      prvINSDEL, prvFULL, prvUNKNOWN);
  151. var Props: CURProps;
  152.     i:     TPasswdPriv;
  153. begin
  154.   Check(DbiGetCursorProps(Cursor, Props));
  155.   case Props.iSeqNums of
  156.     0: FRecNoCap := rnRecordNum;
  157.     1: FRecNoCap := rnSequenceNum;
  158.   else FRecNoCap := rnUnSupported;
  159.   end;
  160.  
  161.   FSoftDelCap := Props.bSoftDeletes;
  162.   FBMStable   := Props.bBookMarkStable;
  163.   FBlockSize  := Props.iBlockSize;
  164.   FTableLevel := Props.iTblLevel;
  165.   FProtected  := Props.bProtected;
  166.   FPasswords  := Props.iPasswords;
  167.   FRestructVer:= Props.iRestrVersion;
  168.  
  169.   FTableRights := [];
  170.   for i := prNone to prUnknown do
  171.     if (Props.eprvRights and PrivRights[i]) = PrivRights[i] then
  172.       Include(FTableRights, i);
  173.  
  174.   StrCopy(FTblType, Props.szTableType);
  175. end;
  176.  
  177. procedure TjocTable.SetShowDeleted(const Value: Boolean);
  178. begin
  179.   if State = dsInactive then DBError(SDataSetClosed);
  180.   if (Value <> FShowDeleted) then
  181.   begin
  182.     if FSoftDelCap then
  183.     begin
  184.       Check(DbiSetProp(HDBIObj(Handle), curSOFTDELETEON, LongInt(Value)));
  185.       FShowDeleted := Value;
  186.     end
  187.     else
  188.       FShowDeleted := False;
  189.   end;
  190. end;
  191.  
  192. function TjocTable.CreateHandle: HDBICur;
  193. begin
  194.   Result := inherited CreateHandle;
  195.   InitTableProperties(Result);   {initialise table capabilities flags}
  196. end;
  197.  
  198. procedure TjocTable.CheckActiveExclusive;
  199. begin
  200.   if not(Active and Exclusive) then
  201.     DatabaseError('Table must be opened for exclusive use');
  202. end;
  203.  
  204. procedure TjocTable.CheckRemote;
  205. begin
  206.   if Active and Database.IsSQLBased then
  207.     DatabaseError('Operation not applicable to remote tables');
  208. end;
  209.  
  210. function TjocTable.GetDeleted: Boolean;
  211. var Props: RECProps;
  212. begin
  213.   Result := False;
  214.   if State = dsInactive then DBError(SDataSetClosed);
  215.  
  216.   if FSoftDelCap then
  217.   try
  218.     UpdateCursorPos;
  219.     Check(DbiGetRecord(Handle, dbiNOLOCK, nil, @Props));
  220.     Result := Props.bDeleteFlag;
  221.   except
  222.     Result := False;
  223.   end;
  224. end;
  225.  
  226. {$IFNDEF Win32}
  227. function TjocTable.GetRecordNumber: LongInt;
  228. var Props: RECProps;
  229. begin
  230.   Result := -1;
  231.   UpdateCursorPos;
  232.   Check(DbiGetRecord(Handle, dbiNOLOCK, nil, @Props));
  233.   case FRecNoCap of
  234.     rnSequenceNum: Result := Props.iSeqNum;
  235.     rnRecordNum:   Result := Props.iPhyRecNum;
  236.   end;
  237. end;
  238. {$ENDIF}
  239.  
  240. procedure TjocTable.UndeleteRecord;
  241. var Props: RECProps;
  242. begin
  243.   if State = dsInactive then DBError(SDataSetClosed);
  244.   if FSoftDelCap then
  245.   begin
  246.     UpdateCursorPos;
  247.     Check(DbiGetRecord(Handle, dbiNOLOCK, nil, @Props));
  248.     Check(DbiUndeleteRecord(Handle));
  249.   end;
  250. end;
  251.  
  252. procedure TjocTable.GotoRecord(const RecNo: LongInt);
  253. begin
  254.   if State = dsInactive then DBError(SDataSetClosed);
  255.   UpdateCursorPos;
  256.   case FRecNoCap of
  257.     rnSequenceNum: Check(DbiSetToSeqNo(Handle, RecNo));
  258.     rnRecordNum:   Check(DbiSetToRecordNo(Handle, RecNo));
  259.   end;
  260.   Refresh;
  261. end;
  262.  
  263. procedure TjocTable.MoveRelative(const Delta: LongInt);
  264. begin
  265.   if State = dsInactive then DBError(SDataSetClosed);
  266.   UpdateCursorPos;
  267.   Check(DbiGetRelativeRecord(Handle, Delta, dbiNOLOCK, nil, nil));
  268.   Refresh;
  269. end;
  270.  
  271. procedure TjocTable.Flush;
  272. begin
  273.   if State = dsBrowse then
  274.     Check(DbiSaveChanges(Handle));
  275. end;
  276.  
  277. procedure TjocTable.Pack;
  278. var SaveActive, SaveExcl: Boolean;
  279. begin
  280.   SaveActive := Active;
  281.   SaveExcl   := Exclusive;
  282.  
  283.   try
  284.     Close;
  285.     Exclusive := True;
  286.     Open;
  287.     if StrComp(FTblType,szPARADOX) = 0 then
  288.       PackPdoxTable
  289.     else
  290.       if StrComp(FTblType,szDBASE) = 0 then
  291.         Check(DbiPackTable(Database.Handle, Handle, nil, nil, True))
  292.       else
  293.         DatabaseError(format('Cannot pack this table type (%s)', [FTblType]));
  294.   finally
  295.     Close;
  296.     Exclusive := SaveExcl;
  297.     Active    := SaveActive;
  298.   end;
  299. end;
  300.  
  301. procedure TjocTable.PackPdoxTable;
  302. var TblDesc: CRTblDesc;
  303.     hDB:  HDbiDb;
  304.     RetCode: DBIResult;
  305. begin
  306.   FillChar(TblDesc, sizeof(TblDesc), 0);
  307.   StrPCopy(TblDesc.szTblName, TableName);
  308.   StrCopy(TblDesc.szTblType, FTblType);
  309.   TblDesc.bPack := True;
  310.  
  311.   hDB := Database.Handle;
  312.   Close;
  313.   Check(DbiDoRestructure(hDB, 1, @TblDesc, nil, nil, nil, False));
  314. end;
  315.  
  316. {$IFNDEF Win32}
  317. procedure TjocTable.RenameTable(const RenameTo: string);
  318. var hDB: HDbiDb;
  319.     RenFrom, RenTo: array[0..DBIMAXTBLNAMELEN] of char;
  320.     RetCode: DBIResult;
  321.     SaveActive, SaveExcl: Boolean;
  322. begin
  323.   SaveActive := Active;
  324.   SaveExcl   := Exclusive;
  325.  
  326.   StrPCopy(RenTo, RenameTo);
  327.   StrPCopy(RenFrom, TableName);
  328.  
  329.   try
  330.     Close;
  331.     Exclusive := True;
  332.     Open;
  333.     hDB := Database.Handle;
  334.     Close;
  335.     Check(DbiRenameTable(hDB, RenFrom, nil, RenTo));
  336.   finally
  337.     Close;
  338.     TableName := RenameTo;
  339.     Exclusive := SaveExcl;
  340.     Active    := SaveActive;
  341.   end;
  342. end;
  343. {$ENDIF}
  344.  
  345. procedure TjocTable.CopyTable(const Destination: string);
  346. var CopyFrom, CopyTo: array[0..DBIMAXTBLNAMELEN] of char;
  347. begin
  348.   if State = dsInactive then DBError(SDataSetClosed);
  349.  
  350.   LockTable(ltReadLock);
  351.   StrPCopy(CopyTo, Destination);
  352.   StrPCopy(CopyFrom, TableName);
  353.  
  354.   Check(DbiCopyTable(Database.Handle, True, CopyFrom, nil, CopyTo));
  355.   UnLockTable(ltReadLock);
  356. end;
  357.  
  358. procedure TjocTable.RebuildIndexes;
  359. var SaveActive, SaveExcl: Boolean;
  360. begin
  361.   CheckRemote;
  362.   SaveActive := Active;
  363.   SaveExcl   := Exclusive;
  364.  
  365.   try
  366.     Close;
  367.     Exclusive := True;
  368.     Open;
  369.     Check(DbiRegenIndexes(Handle));
  370.   finally
  371.     Exclusive := SaveExcl;
  372.     Active    := SaveActive;
  373.   end;
  374. end;
  375.  
  376. procedure TjocTable.RebuildIndex(const Idx: Integer);
  377. var IDesc: IDXDesc;
  378.     wIdx: Word;
  379.     SaveActive, SaveExcl: Boolean;
  380. begin
  381.   CheckRemote;
  382.   if (Idx <= 0) then
  383.     DatabaseError('Invalid index sequence number');
  384.   SaveActive := Active;
  385.   SaveExcl   := Exclusive;
  386.  
  387.   IndexDefs.Update;
  388.  
  389.   if (Idx <= IndexDefs.Count) then
  390.     try
  391.       Close;
  392.       Exclusive := True;
  393.       Open;
  394.       wIdx := Word(Idx);
  395.       Check(DbiGetIndexDesc(Handle, wIdx, IDesc));
  396.       Check(DbiRegenIndex(Database.Handle, Handle, nil,
  397.               nil, IDesc.szName, IDesc.szTagName, IDesc.iIndexID));
  398.     finally
  399.       Close;
  400.       Exclusive := SaveExcl;
  401.       Active    := SaveActive;
  402.     end else
  403.       DataBaseError('Index not found');
  404. end;
  405.  
  406. procedure TjocTable.RebuildNamedIndex(const IdxName: TDbiNameStr);
  407. var IDesc: IDXDesc;
  408.     Idx:   Integer;
  409.     wIdx:  Word;
  410.     SaveActive, SaveExcl: Boolean;
  411.  
  412. begin
  413.   CheckRemote;
  414.   SaveActive := Active;
  415.   SaveExcl   := Exclusive;
  416.   IndexDefs.Update;
  417.   Idx := IndexDefs.IndexOf(IdxName);
  418.  
  419.   if (Idx >= 0) then
  420.     try
  421.       Close;
  422.       Exclusive := True;
  423.       Open;
  424.       wIdx := Succ(Idx);
  425.       Check(DbiGetIndexDesc(Handle, wIdx, IDesc));
  426.       Check(DbiRegenIndex(Database.Handle, Handle, nil,
  427.               nil, IDesc.szName, IDesc.szTagName, IDesc.iIndexId));
  428.     finally
  429.       Close;
  430.       Exclusive := SaveExcl;
  431.       Active    := SaveActive;
  432.     end else
  433.       DatabaseError(format('Index %s not found', [IdxName]));
  434. end;
  435.  
  436. procedure Register;
  437. begin
  438.   RegisterComponents('JOC', [TjocTable]);
  439. end;
  440.  
  441. end.
  442.